home *** CD-ROM | disk | FTP | other *** search
/ Power Programmierung / Power-Programmierung (Tewi)(1994).iso / magazine / progjour / 1991 / 02 / xmsdump.pas < prev   
Pascal/Delphi Source File  |  1990-10-31  |  8KB  |  229 lines
  1. program XmsDump;
  2.  
  3. const
  4.   ExhaustiveXms : Boolean = False;  {True to scan all XMS blocks}
  5. var
  6.   XmsControl    : Pointer;          {Pointer to XMS control procedure}
  7.  
  8.   function XmsInstalledPrim : Boolean;
  9.     {-Returns True if an XMS memory manager is installed}
  10.   inline(
  11.     $B8/$00/$43/     {   MOV     AX,$4300           ; XMS Installed function}
  12.     $CD/$2F/         {   INT     $2F                ; DOS Multiplex int}
  13.     $3C/$80/         {   CMP     AL,$80             ; is it there?}
  14.     $75/$04/         {   JNE     NoXmsDriver}
  15.     $B0/$01/         {   MOV     AL,1               ; return True}
  16.     $EB/$02/         {   JMP     SHORT XIExit}
  17.                      {NoXmsDriver:}
  18.     $30/$C0);        {   XOR     AL,AL              ; return False}
  19.                      {XIExit:}
  20.  
  21.   function XmsControlAddr : Pointer;
  22.     {-Return address of XMS control function}
  23.   inline(
  24.     $B8/$10/$43/     {MOV     AX,$4310           ; XMS control func addr}
  25.     $CD/$2F/         {INT     $2F}
  26.     $89/$D8/         {MOV     AX,BX              ; ptr in ES:BX to DX:AX}
  27.     $8C/$C2);        {MOV     DX,ES}
  28.  
  29.   function QueryFreeExtMem(var TotalFree, LargestBlock : Word) : Byte;
  30.     {-Return total free and largest free block of XMS}
  31.   var
  32.     ErrorCode : Byte;
  33.   begin
  34.     inline(
  35.       $B4/$08/               {  MOV    AH,$08   ;Query Free ext memory}
  36.       $FF/$1E/>XmsControl/   {  CALL   DWORD PTR [>XmsControl]}
  37.       $09/$C0/               {  OR     AX,AX}
  38.       $74/$10/               {  JZ     SetError}
  39.       $30/$DB/               {  XOR    BL,BL}
  40.       $C4/$BE/>TotalFree/    {  LES    DI,>TotalFree[BP]}
  41.       $26/                   {ES:}
  42.       $89/$15/               {  MOV    [DI],DX}
  43.       $C4/$BE/>LargestBlock/ {  LES    DI,>LargestBlock[BP]}
  44.       $26/                   {ES:}
  45.       $89/$05/               {  MOV    [DI],AX}
  46.                              {SetError:}
  47.       $88/$5E/<ErrorCode);   {  MOV    <ErrorCode[BP],BL}
  48.     QueryFreeExtMem := ErrorCode;
  49.   end;
  50.  
  51.   function GetHandleInfo(XmsHandle : Word;
  52.                          var LockCount    : Byte;
  53.                          var HandlesLeft  : Byte;
  54.                          var BlockSizeInK : Word) : Byte;
  55.     {-Return information about specified XMS handle}
  56.   var
  57.     ErrorCode : Byte;
  58.   begin
  59.     inline(
  60.       $B4/$0E/               {  MOV    AH,$0E   ;Get EMB Handle Info}
  61.       $8B/$96/>XmsHandle/    {  MOV    DX,>XmsHandle[BP]}
  62.       $FF/$1E/>XmsControl/   {  CALL   DWORD PTR [>XmsControl]}
  63.       $A9/$01/$00/           {  TEST   AX,1}
  64.       $74/$17/               {  JZ     SetError}
  65.       $C4/$BE/>LockCount/    {  LES    DI,>LockCount[BP]}
  66.       $26/                   {ES:}
  67.       $88/$3D/               {  MOV    BYTE PTR [DI],BH}
  68.       $C4/$BE/>HandlesLeft/  {  LES    DI,>HandlesLeft[BP]}
  69.       $26/                   {ES:}
  70.       $88/$1D/               {  MOV    BYTE PTR [DI],BL}
  71.       $C4/$BE/>BlockSizeInK/ {  LES    DI,>BlockSizeInK[BP]}
  72.       $26/                   {ES:}
  73.       $89/$15/               {  MOV    [DI],DX}
  74.       $30/$DB/               {  XOR    BL,BL}
  75.                              {SetError:}
  76.       $88/$5E/<ErrorCode);   {  MOV    <ErrorCode[BP],BL}
  77.     GetHandleInfo := ErrorCode;
  78.   end;
  79.  
  80.   function AllocateExtMem(SizeInK : Word; var XmsHandle : Word) : Byte;
  81.     {-Allocate a block of extended memory}
  82.   var
  83.     ErrorCode : Byte;
  84.   begin
  85.     inline(
  86.       $B4/$09/               {  MOV    AH,$09   ;XMS function 09h - Alloc ext memory block}
  87.       $8B/$96/>SizeInK/      {  MOV    DX,>SizeInK[BP]}
  88.       $FF/$1E/>XmsControl/   {  CALL   DWORD PTR [>XmsControl]}
  89.       $A9/$01/$00/           {  TEST   AX,1}
  90.       $74/$09/               {  JZ     SetError}
  91.       $30/$DB/               {  XOR    BL,BL}
  92.       $C4/$BE/>XmsHandle/    {  LES    DI,>XmsHandle[BP]}
  93.       $26/                   {ES:}
  94.       $89/$15/               {  MOV    [DI],DX  ;return XMS handle}
  95.                              {SetError:}
  96.       $88/$5E/<ErrorCode);   {  MOV    <ErrorCode[BP],BL}
  97.     AllocateExtMem := ErrorCode;
  98.   end;
  99.  
  100.   function FreeExtMem(XmsHandle : Word) : Byte;
  101.     {-Free a block of extended memory given its handle}
  102.   var
  103.     ErrorCode : Byte;
  104.   begin
  105.     inline(
  106.       $B4/$0A/               {  MOV    AH,$0A   ;XMS function 0Ah - Free ext memory block}
  107.       $8B/$96/>XmsHandle/    {  MOV    DX,>XmsHandle[BP]}
  108.       $FF/$1E/>XmsControl/   {  CALL   DWORD PTR [>XmsControl]}
  109.       $A9/$01/$00/           {  TEST   AX,1}
  110.       $74/$02/               {  JZ     SetError}
  111.       $30/$DB/               {  XOR    BL,BL}
  112.                              {SetError:}
  113.       $88/$5E/<ErrorCode);   {  MOV    <ErrorCode[BP],BL}
  114.     FreeExtMem := ErrorCode;
  115.   end;
  116.  
  117.   procedure ShowTheXmsMemory;
  118.     {-Report on allocated extended memory}
  119.   label
  120.     ExitPoint;
  121.   var
  122.     H0 : Word;
  123.     H1 : Word;
  124.     H : Word;
  125.     Delta : Integer;
  126.     HNum : Word;
  127.     HMem : Word;
  128.     FMem : Word;
  129.     FMax : Word;
  130.     Total : Word;
  131.     Status : Byte;
  132.     LockCount : Byte;
  133.     HandlesLeft : Byte;
  134.     Done : Boolean;
  135.   begin
  136.     if XmsInstalledPrim then
  137.       XmsControl := XmsControlAddr
  138.     else begin
  139.       WriteLn('No XMS driver installed');
  140.       Exit;
  141.     end;
  142.  
  143.     Status := QueryFreeExtMem(FMem, FMax);
  144.     if Status = $A0 then begin
  145.       {All XMS has been allocated}
  146.       FMem := 0;
  147.       FMax := 0;
  148.     end else if Status <> 0 then begin
  149.       WriteLn('Error ', Status, ' accessing XMS');
  150.       Exit;
  151.     end;
  152.  
  153.     WriteLn('block   bytes   (XMS Memory)');
  154.     WriteLn('-----   ------');
  155.  
  156.     {Total will count total XMS memory}
  157.     Total := 0;
  158.     {HNum will list the XMS handles in sequential order}
  159.     HNum := 0;
  160.  
  161.     if ExhaustiveXms then begin
  162.       {Search all 64K XMS handles for valid ones}
  163.       for H := 0 to 65535 do begin
  164.         Status := GetHandleInfo(H, LockCount, HandlesLeft, HMem);
  165.         if Status = 0 then begin
  166.           WriteLn(HNum:5, '  ', LongInt(1024)*HMem:7);
  167.           inc(Total, HMem);
  168.           inc(HNum);
  169.         end;
  170.       end;
  171.  
  172.     end else begin
  173.       {Heuristic algorithm to report used handles quickly}
  174.  
  175.       {Allocate two dummy handles}
  176.       if FMem > 1 then
  177.         HMem := 1
  178.       else
  179.         HMem := 0;
  180.       Status := AllocateExtMem(HMem, H0);
  181.       if Status <> 0 then
  182.         goto ExitPoint;
  183.       Status := AllocateExtMem(HMem, H1);
  184.       if Status <> 0 then begin
  185.         {Deallocate dummy handle}
  186.         Status := FreeExtMem(H0);
  187.         goto ExitPoint;
  188.       end;
  189.       Delta := H1-H0;
  190.       {Deallocate one dummy}
  191.       Status := FreeExtMem(H1);
  192.  
  193.       {Trace back through valid handles}
  194.       H := H0;
  195.       repeat
  196.         Status := GetHandleInfo(H, LockCount, HandlesLeft, HMem);
  197.         Done := (Status <> 0);
  198.         if not Done then
  199.           dec(H, Delta);
  200.       until Done;
  201.  
  202.       {Go forward again through valid handles, reporting them}
  203.       inc(H, Delta);
  204.       while H <> H0 do begin
  205.         Status := GetHandleInfo(H, LockCount, HandlesLeft, HMem);
  206.         if Status = 0 then begin
  207.           WriteLn(HNum:5, '  ', LongInt(1024)*HMem:7);
  208.           inc(Total, HMem);
  209.           inc(HNum);
  210.         end;
  211.         inc(H, Delta);
  212.       end;
  213.  
  214.       {Deallocate dummy handle}
  215.       Status := FreeExtMem(H0);
  216.     end;
  217.  
  218.     inc(Total, FMem);
  219.  
  220. ExitPoint:
  221.     WriteLn(' free  ', LongInt(1024)*FMem:7);
  222.     if Total <> 0 then
  223.       WriteLn('total  ', LongInt(1024)*Total:7);
  224.   end;
  225.  
  226. begin
  227.   ShowTheXmsMemory;
  228. end.
  229.